home *** CD-ROM | disk | FTP | other *** search
/ Network Support Library / RoseWare - Network Support Library.iso / btrieve / bconfi.arc / BCONFIG.PAS < prev    next >
Pascal/Delphi Source File  |  1989-05-11  |  13KB  |  430 lines
  1.  Program BConfig;
  2.  
  3.  uses TPCRT,TPDOS,TPWindow;
  4.  
  5.  Type
  6.    Str80 = String[80];
  7.  
  8.  Const
  9.    Menu : Array[0..18] of String[23] =
  10.           ('┌─────────────────────┐',
  11.            '│     BConfig 1.0     │',
  12.            '│BDEBUG config utility│',
  13.            '│ copyright (C) 1989  │',
  14.            '│     Jeff Bowles     │',
  15.            '├─────────────────────┤',
  16.            '│                     │',
  17.            '│   Window position   │',
  18.            '│     Window size     │',
  19.            '│                     │',
  20.            '│     Clone BDEBUG    │',
  21.            '│      Menu Color     │',
  22.            '│ Selection Bar Color │',
  23.            '│     Window Color    │',
  24.            '│ Exit this menu (ESC)│',
  25.            '├─────────────────────┤',
  26.            '│  Use  to move bar. │',
  27.            '│                     │',
  28.            '└─────────────────────┘');
  29.  
  30.    Bwindow : Array[1..22] of string[80] =
  31.              ('Operation    -:                     ┌Key Value─┬─────────────────────────────┐',
  32.               '             -:                     │..........│.............................│',
  33.               'Record Length-: BConfig 1.0         │..........│.............................│',
  34.               'Key No.      -:BDEBUG config        │..........│.............................│',
  35.               'Key Length   -:  (C) 1989           │..........│.............................│',
  36.               '             -: Jeff Bowles         │..........│.............................│',
  37.               'Status       -:                     │..........│.............................│',
  38.               '             -:                     │..........│.............................│',
  39.               '  Hit Any Key To Continue           └──────────┴─────────────────────────────┘',
  40.               '┌Record Buffer Value┬────────────────────────────────────────────────────────┐',
  41.               '│...................│........................................................│',
  42.               '│...................│........................................................│',
  43.               '│...................│........................................................│',
  44.               '│...................│........................................................│',
  45.               '│...................│........................................................│',
  46.               '│...................│........................................................│',
  47.               '│...................│........................................................│',
  48.               '│...................│........................................................│',
  49.               '│...................│........................................................│',
  50.               '│...................│........................................................│',
  51.               '│...................│........................................................│',
  52.               '└───────────────────┴────────────────────────────────────────────────────────┘');
  53.  
  54.    Sel : integer = 0;
  55.  
  56.  var
  57.    Wake,Double,WasIn8x8 : Boolean;
  58.    WPosX,WPosY,WHeight,WWidth : Byte;
  59.    BufPtr : WindowPtr;
  60.    Scr : Pointer;
  61.    Ch,XY,ScanLines : word;
  62.    FullName : string;
  63.    MenuColor, HiColor, WindowColor : Byte;
  64.  
  65.  Procedure ShowToggles;
  66.  Begin
  67.    if Wake then
  68.     FastWrite('       Wake up       ',9,28,MenuColor)
  69.   else
  70.     FastWrite('        Sleep        ',9,28,MenuColor);
  71.   if Double then
  72.     FastWrite('    Double Strike    ',12,28,MenuColor)
  73.   else
  74.     FastWrite('    Single Strike    ',12,28,MenuColor);
  75.  End;
  76.  
  77.  Procedure MenuBar (Hilite : boolean);
  78.  Begin
  79.    Case sel of
  80.      5,6,7 :
  81.        FastWrite(' F5 ForeGr F6 BackGr.',20,28,HiColor);
  82.      else
  83.        FastWrite(' Hit enter to select.',20,28,HiColor);
  84.    end;
  85.  
  86.    if Hilite = True then
  87.      ChangeAttribute(21,9+sel,28,HiColor)
  88.    else
  89.      ChangeAttribute(21,9+sel,28,MenuColor);
  90.  End;
  91.  
  92.  Procedure ShowWindow;
  93.  var X:integer;
  94.  Begin
  95.    if not DisplayWindow(BufPtr) then {};
  96.    HiddenCursor;
  97.    For x := 1 to Wheight-2 do
  98.      FastWriteClip(bwindow[x],x,1,WindowColor);
  99.  End;
  100.  
  101.  Procedure ShowMenu(ReadKbd : boolean); forward;
  102.  
  103.  Procedure WindowSize;
  104.  var ch : word;
  105.  
  106.   Begin
  107.   Ch := 0;
  108.   if not (EraseTopWindow = nil) then {};
  109.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  110.   ShowWindow;
  111.   Repeat
  112.     Ch := ReadKeyWord;
  113.     case Ch of
  114.       $4b00 : {left}
  115.           if WWidth > $1f then
  116.             if ResizeWindow(-1,0,' ') then dec(WWidth);
  117.  
  118.       $4d00 : {right}
  119.           If ResizeWindow(1,0,' ') then inc(WWidth);
  120.  
  121.       $4800 : {up}
  122.           if WHeight > $0b then
  123.             If ResizeWindow(0,-1,' ') then dec(WHeight);
  124.  
  125.       $5000 : {down}
  126.             if WHeight < 24 then
  127.               If ResizeWindow(0,1,' ') then Inc(WHeight);
  128.  
  129.     End;
  130.     ShowWindow;
  131.   until (ch = $011b) or (ch = $1c0d) ; {esc or enter}
  132.   if (EraseTopWindow=nil) then {};
  133.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  134.   ShowMenu(True);
  135.   ShowToggles;
  136.   End;
  137.  
  138.  Procedure WindowPos;
  139.  var ch : word;
  140.  
  141.   Begin
  142.   Ch := 0;
  143.   if not (EraseTopWindow = nil) then {};
  144.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  145.   ShowWindow;
  146.   Repeat
  147.     Ch := ReadKeyWord;
  148.     case Ch of
  149.       $4b00 : {left}
  150.         if MoveWindow(-1,0) then dec(WPosX);
  151.       $4d00 : {right}
  152.           If MoveWindow(1,0) then inc(WPosX);
  153.       $4800 : {up}
  154.           If MoveWindow(0,-1) then dec(WPosY);
  155.       $5000 : {down}
  156.           If WPosY < 23 then
  157.               If MoveWindow(0,1) then inc(WPosY);
  158.     End;
  159.     ShowWindow;
  160.   until (ch = $011b) or (ch = $1c0d) ; {esc or enter}
  161.   if (EraseTopWindow=nil) then {};
  162.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  163.   ShowMenu(True);
  164.   ShowToggles;
  165.   End;
  166.  
  167.   Procedure SoundBlip(HZ : Integer);
  168.   Begin
  169.     sound(HZ);
  170.     delay(50);
  171.     nosound;
  172.   End;
  173.  
  174.   Procedure HeyYou;
  175.   Begin
  176.     FastWrite(' F5 ForeGr F6 BackGr.',20,28,(HiColor or $80));
  177.     SoundBlip(500);
  178.     Delay(1500);
  179.     FastWrite(' F5 ForeGr F6 BackGr.',20,28,HiColor);
  180.     {};
  181.   End;
  182.  
  183.  Procedure Clone;
  184.  const
  185.    Fname : string = 'BDEBUG.COM';
  186.  var
  187.    CloneFile : File of Byte;
  188.    temp : byte;
  189.  
  190.  Begin
  191.    FastWrite(' *** Now Cloning *** ',13,28,MenuColor);
  192.    MenuBar (True);
  193.    SoundBlip(2000);
  194.    Assign(CloneFile,fullname);
  195.    Reset(CloneFile);
  196.    Seek(CloneFile,$127f);
  197.    Write(CloneFile,WPosY);
  198.    Write(CloneFile,WPosX);
  199.    Write(CloneFile,WHeight);
  200.    Write(CloneFile,WWidth);
  201.    Temp := ord(Double);
  202.    Write(CloneFile,Temp);
  203.    Seek(CloneFile,$26d5);
  204.    Temp := ord(Wake);
  205.    Write(cloneFile,Temp);
  206.    Seek(clonefile,$3ea2);
  207.    Temp := $fd;
  208.    Write(clonefile,Temp);
  209.    Seek(CloneFile,$3A18);
  210.    Write(CloneFile,WindowColor);
  211.    Seek(CloneFile,$3CFB);
  212.    Write(CloneFile,MenuColor);
  213.    Seek(CloneFile,$3D2E);
  214.    Write(CloneFile,HiColor);
  215.    Close(CloneFile);
  216.    SoundBlip(2000);
  217.    FastWrite('     Clone BDEBUG    ',13,28,MenuColor);
  218.    MenuBar (True);
  219.  End;
  220.  
  221.  Procedure Select;
  222.  Begin
  223.    Case Sel of
  224.      0 :                     {wake/sleep}
  225.        Begin
  226.          Wake := Not(Wake);
  227.          ShowToggles;
  228.          MenuBar (True);
  229.        End;
  230.      1 :                     {window pos}
  231.        WindowPos;
  232.      2 :                     {window size}
  233.        WindowSize;
  234.      3 :                     {single/double}
  235.        Begin
  236.          Double := Not(Double);
  237.          Showtoggles;
  238.          MenuBar (True);
  239.        End;
  240.      4 :                     {clone}
  241.        Clone;
  242.      5 : HeyYou;             {use F7-F8 instead}
  243.      6 : HeyYou;             {use F7-F8 instead}
  244.      7 : HeyYou;             {use F7-F8 instead}
  245.      8 : Ch := $011b;        {quit}
  246.    End;
  247.  End;
  248.  
  249.  Procedure SetFG( Var Kolor : Byte);
  250.  var f : byte;
  251.  begin;
  252.    f := (Kolor and $0F);
  253.    inc(f);
  254.    if f > 15 then f:=0;
  255.    Kolor := ((Kolor and $F0) or f);
  256.    ShowMenu(False);
  257.  end;
  258.  
  259.  Procedure SetBG( Var Kolor : Byte);
  260.  var B : byte;
  261.  begin
  262.    B := Kolor SHR 4;
  263.    inc(B);
  264.    if B > 7 then b := 0;
  265.    Kolor := ((Kolor and $0F) or (B SHL 4));
  266.    ShowMenu(False);
  267.  End;
  268.  
  269.  Procedure ShowMenu(ReadKbd : Boolean);
  270.  var x, terminal : byte;
  271.  Begin
  272.    HiddenCursor;
  273.    if ReadKbd then Terminal := 18 else Terminal := 5;
  274.  
  275.    for x:=0 to Terminal do
  276.      begin
  277.        FastWrite(Menu[x],3+x,27,MenuColor);
  278.        If (x>0) and (x<5) then
  279.          ChangeAttribute(21,3+x,28,WindowColor);
  280.      end;
  281.    showtoggles;
  282.    MenuBar (True);
  283.    If Not ReadKbd then Exit;
  284.    Ch := 0;
  285.    Repeat
  286.      Ch := ReadKeyWord;
  287.      case Ch of
  288.        $1c0d : {enter}
  289.          Select;
  290.        $4800 : {up}
  291.          Begin
  292.            MenuBar (False);
  293.            dec(sel);
  294.            if sel<0 then sel := 8;
  295.            MenuBar (True);
  296.          End;
  297.        $5000 : {down}
  298.          Begin
  299.            MenuBar (False);
  300.            inc(sel);
  301.            if sel>8 then sel := 0;
  302.            MenuBar (True);
  303.          End;
  304.  
  305.        $3f00 : {F5 set foreground color}
  306.          begin
  307.            Case Sel of
  308.              5: Begin
  309.                   SetFG(MenuColor);
  310.                   ShowMenu(True);
  311.                 end;
  312.              6: Begin
  313.                   SetFG(HiColor);
  314.                   MenuBar(True);
  315.                   With WindowP(BufPtr)^ do
  316.                     begin
  317.                       Draw.HAttr := HiColor;
  318.                       DisplayedOnce := False;
  319.                     end;
  320.                 end;
  321.              7: Begin
  322.                   SetFG(WindowColor);
  323.                   ShowMenu(False);
  324.                   With WindowP(BufPtr)^ do
  325.                     begin
  326.                       Draw.FAttr := WindowColor;
  327.                       Draw.WAttr :=WindowColor;
  328.                       DisplayedOnce := False;
  329.                     end;
  330.                 End;
  331.              else
  332.                 SoundBlip(500);
  333.            end;
  334.          end;
  335.        $4000 : {F6 set background color}
  336.          begin
  337.            Case Sel of
  338.              5: Begin
  339.                   SetBG(MenuColor);
  340.                   ShowMenu(True);
  341.                 End;
  342.              6: Begin
  343.                   SetBG(HiColor);
  344.                   MenuBar(True);
  345.                   With WindowP(BufPtr)^ do
  346.                     begin
  347.                       Draw.HAttr := HiColor;
  348.                       DisplayedOnce := False;
  349.                     end;
  350.                 End;
  351.              7: Begin
  352.                   SetBG(WindowColor);
  353.                   ShowMenu(False);
  354.                   With WindowP(BufPtr)^ do
  355.                     begin
  356.                       Draw.FAttr := WindowColor;
  357.                       Draw.WAttr := WindowColor;
  358.                       DisplayedOnce := False;
  359.                     end;
  360.                 End;
  361.              else
  362.                 SoundBlip(500);
  363.            end;
  364.          end;
  365.      End;
  366.    until ch = $011b; {esc}
  367.    NormalCursor;
  368.  End;
  369.  
  370.  Procedure ReadCloneFile;
  371.  const
  372.    Fname : string = 'BDEBUG.COM';
  373.  var
  374.    CloneFile : File of Byte;
  375.    temp : byte;
  376.  Begin
  377.    if Not ExistOnPath(Fname,fullname) then
  378.      Begin
  379.        Writeln('Cannot find BDEBUG.COM on search path.');
  380.        Halt(1);
  381.      End;
  382.    GetCursorState(XY,ScanLines);
  383.    Explode := true;
  384.    ExplodeDelay := 5;
  385.    SoundFlagW := true;
  386.    SetFrameChars(#186,#205,#188,#187,#200,#201);
  387.    Assign(CloneFile,fullname);
  388.    Reset(CloneFile);
  389.    Seek(CloneFile,$127f);
  390.    Read(CloneFile,WPosY);
  391.    Read(CloneFile,WPosX);
  392.    Read(CloneFile,WHeight);
  393.    Read(CloneFile,WWidth);
  394.    Read(CloneFile,Temp);
  395.     Double := (Temp = 1);
  396.    Seek(CloneFile,$26d5);
  397.     Read(CloneFile,Temp);
  398.    Wake := (Temp = 1);
  399.    Seek(CloneFile,$3A18);
  400.    Read(CloneFile,WindowColor);
  401.    Seek(CloneFile,$3CFB);
  402.    Read(CloneFile,MenuColor);
  403.    Seek(CloneFile,$3D2E);
  404.    Read(CloneFile,HiColor);
  405.    Close(CloneFile);
  406.  End;
  407.  
  408.  Begin {main}
  409.  
  410.    ReadCloneFile;
  411.    if SaveWindow(1,1,ScreenWidth,ScreenHeight,True,Scr) then
  412.      begin
  413.        If Font8x8Selected then
  414.          begin
  415.            SelectFont8x8(False);
  416.            WasIn8x8 := True;
  417.          end
  418.        else
  419.          WasIn8x8 := False;
  420.  
  421.        If MakeWindow(BufPtr,WPosX+1,WPosY+1,WPosX+WWidth,
  422.                      WPosY+WHeight,True,True,True,WindowColor,
  423.                      WindowColor,HiColor,' Sample Window ') then  ShowMenu(True);
  424.  
  425.        RestoreWindow(1,1,ScreenWidth,ScreenHeight,True,Scr);
  426.        RestoreCursorState(XY,ScanLines);
  427.        If WasIn8x8 then SelectFont8x8(True);
  428.      end;
  429.  End. {main}
  430.